home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / semaphores.c < prev    next >
C/C++ Source or Header  |  1992-06-18  |  5KB  |  224 lines
  1. /* ******************************************************************** */
  2. /* semaphores.c      Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Lisp semaphores                                               */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: semaphores.c,v 1.8 1992/06/09 14:05:48 pab Exp $
  9.  *
  10.  * $Log: semaphores.c,v $
  11.  * Revision 1.8  1992/06/09  14:05:48  pab
  12.  * fixed includes
  13.  *
  14.  * Revision 1.7  1992/05/28  11:27:36  pab
  15.  * changed value vector (unused)
  16.  *
  17.  * Revision 1.6  1992/05/19  11:26:08  pab
  18.  * fixed to be strings
  19.  *
  20.  * Revision 1.5  1992/01/29  13:46:17  pab
  21.  * sysV fixes
  22.  *
  23.  * Revision 1.4  1992/01/09  22:29:01  pab
  24.  * Fixed for low tag ints
  25.  *
  26.  * Revision 1.3  1992/01/05  22:48:18  pab
  27.  * Minor bug fixes, plus BSD version
  28.  *
  29.  * Revision 1.2  1991/09/11  12:07:34  pab
  30.  * 11/9/91 First Alpha release of modified system
  31.  *
  32.  * Revision 1.1  1991/08/12  16:49:55  pab
  33.  * Initial revision
  34.  *
  35.  * Revision 1.4  1991/03/27  18:25:06  kjp
  36.  * Changes + arg parity correction.
  37.  *
  38.  * Revision 1.3  1991/02/13  18:24:43  kjp
  39.  * Pass.
  40.  *
  41.  */
  42.  
  43. /*
  44.  * Change Log:
  45.  *   Version 1, April 1990
  46.  */
  47.  
  48. #include "defs.h"
  49. #include "structs.h"
  50. #include "funcalls.h"
  51. #include "error.h"
  52.  
  53. #include "global.h"
  54.  
  55. #include "calls.h"
  56. #include "modboot.h"
  57. #include "allocate.h"
  58. #include "modules.h"
  59. #include "threads.h"
  60.  
  61. #ifndef MACHINE_ANY
  62. #define semaphoreof(x) ((SystemSemaphore*) (stringof(x)))
  63. /* Generator... */
  64.  
  65. EUFUN_0( Fn_make_semaphore)
  66. {
  67.   LispObject retval;
  68.  
  69.   retval = allocate_string(stacktop,"",sizeof(SystemSemaphore));
  70.  
  71.   system_initialise_semaphore(semaphoreof(retval));
  72.  
  73.   return(retval);
  74.  
  75. }
  76. EUFUN_CLOSE
  77.  
  78. /* Initialiser... */
  79.  
  80. EUFUN_1( Fn_primitive_initialize_semaphore, sem)
  81. {
  82.  
  83.   if (!is_string(sem))
  84.     CallError(stacktop,
  85.           "initialize-semaphore: non semaphore",sem,NONCONTINUABLE);
  86.  
  87.   /* System specific call... */
  88.  
  89.   system_initialise_semaphore(semaphoreof(sem));
  90.  
  91.   /* Trusting OK... */
  92.  
  93.   return(sem);
  94.  
  95. }
  96. EUFUN_CLOSE
  97.  
  98. /* Opener... */
  99.  
  100. EUFUN_1( Fn_open_semaphore, sem)
  101. {
  102.  
  103.   if (!is_string(sem))
  104.     CallError(stacktop,"open-semaphore: non semaphore",sem,NONCONTINUABLE);
  105.  
  106.   /* System specific call... */
  107.  
  108.   while (!system_maybe_open_semaphore(stacktop,(semaphoreof(ARG_0(stackbase)))))
  109.     EUCALL_0(Fn_thread_reschedule);
  110.  
  111.   /* Got it... */
  112.  
  113.   return(ARG_0(stackbase));
  114.  
  115. }
  116. EUFUN_CLOSE
  117.  
  118. /* Closer... */
  119.  
  120. EUFUN_1( Fn_close_semaphore, sem)
  121. {
  122.  
  123.   if (!is_string(sem))
  124.     CallError(stacktop,"close-semaphore: non semaphore",sem,NONCONTINUABLE);
  125.  
  126.   /* Syspec.. */
  127.  
  128.   system_close_semaphore((semaphoreof(sem)));
  129.  
  130.   return(sem);
  131.  
  132. }
  133. EUFUN_CLOSE
  134.  
  135. static SYSTEM_GLOBAL(SystemSemaphore,test_sem);
  136. static SYSTEM_GLOBAL(int,test_sum);
  137. static SYSTEM_GLOBAL(int,test_total);
  138.  
  139. static LispObject runner(LispObject *stacktop)
  140. {
  141.   int n;
  142.  
  143.   for (n=0; n<SYSTEM_GLOBAL_VALUE(test_total); ++n) {
  144.     system_open_semaphore(stacktop,&SYSTEM_GLOBAL_VALUE(test_sem));
  145.     ++SYSTEM_GLOBAL_VALUE(test_sum);
  146.     system_close_semaphore(&SYSTEM_GLOBAL_VALUE(test_sem));
  147.   }
  148.  
  149.   return(nil);
  150. }
  151.  
  152. EUFUN_2( Fn_test_internal_semaphore, threads, count)
  153. {
  154.   LispObject th[100];
  155.   int cthreads,i;
  156.  
  157.   cthreads = intval(threads);
  158.  
  159.   SYSTEM_GLOBAL_VALUE(test_total) = intval(count);
  160.   SYSTEM_GLOBAL_VALUE(test_sum) = 0;
  161.  
  162.   for (i=0; i<cthreads; ++i) {
  163.     LispObject xx;
  164.     xx = (LispObject)
  165.       allocate_module_function(stacktop,
  166.                    (LispObject)NULL,(LispObject)NULL,runner,0);
  167.     EUCALLSET_2(th[i], Fn_make_thread, xx, nil);
  168.     EUCALL_2(Fn_thread_start,th[i],nil);
  169.   }
  170.  
  171.   for (i=0; i<cthreads; ++i) {
  172.     EUCALL_1(Fn_thread_value,th[i]);
  173.   }
  174.  
  175.   return(allocate_integer(stacktop,SYSTEM_GLOBAL_VALUE(test_sum)));
  176. }
  177. EUFUN_CLOSE
  178.  
  179. #endif
  180.   
  181. /* *************************************************************** */
  182. /* Initialisation of this section                                  */
  183. /* *************************************************************** */
  184.  
  185. #ifndef MACHINE_ANY
  186. #define SEMAPHORES_ENTRIES 5
  187. #else
  188. #define SEMAPHORES_ENTRIES 0
  189. #endif
  190.  
  191. MODULE Module_semaphores;
  192. LispObject Module_semaphores_values[1];
  193.  
  194. void initialise_semaphores(LispObject *stacktop)
  195. {
  196.  
  197.   open_module(stacktop,
  198.           &Module_semaphores,
  199.           Module_semaphores_values,"sems",SEMAPHORES_ENTRIES);
  200.  
  201. #ifndef MACHINE_ANY
  202.  
  203.   (void) make_module_function(stacktop,"make-primitive-semaphore",Fn_make_semaphore,0);
  204.   (void) make_module_function(stacktop,"initialize-primitive-semaphore",
  205.                   Fn_primitive_initialize_semaphore,1);
  206.   (void) make_module_function(stacktop,"open-primitive-semaphore",Fn_open_semaphore,1);
  207.   (void) make_module_function(stacktop,"close-primitive-semaphore",Fn_close_semaphore,1);
  208.  
  209.   SYSTEM_INITIALISE_GLOBAL(SystemSemaphore,test_sem,NULL);
  210.   SYSTEM_INITIALISE_GLOBAL(int,test_sum,0);
  211.   SYSTEM_INITIALISE_GLOBAL(int,test_total,0);
  212.  
  213.   system_allocate_semaphore(&SYSTEM_GLOBAL_VALUE(test_sem));
  214.  
  215.   (void) make_module_function(stacktop,"test-internal-semaphores",
  216.                   Fn_test_internal_semaphore,2);
  217.  
  218. #endif
  219.  
  220.   close_module();
  221.  
  222. }
  223.  
  224.